perm filename TAB.F4[TAB,LCS] blob
sn#213118 filedate 1976-04-27 generic text, type T, neo UTF8
00100 C CONVERTS LUTE TABLATURE TO STANDARD INPUT FOR MS.
00200
00300 DIMENSION I(72),IQ(72),LET(14),NUM(8),LIST(14),KLST(8)
00400 1,RI(72),STR(50),FOR(4)
00500 C NO MORE THAN 50 NOTES PER FILE.
00600 C NOTE: USE 'C' FOR r AND 'Q' FOR k. (R=REST, K=KEY SIG.)
00700 C ON THE OTHER HAND! USE 'Z' FOR MEASURE LINES ('M' IS TABLATURE ITEM)
00800 DATA LET/'A','B','C','D','E','F','G','H','I','J','Q',
00900 1 'L','M','N'/,NUM/'1','2','3','4','5','6','7','8'/
01000 1,LSL/'/'/,IBLA/' '/,ICOL/':'/,ISEMI/';'/,MIN/'-'/
01100 1,IR/'R'/,IX/'X'/,IZ/'Z'/,M100/100/
01200 1,LIST/'A','B','B','C','C','D','E','E','F','F',
01300 1 'G','G','A','B'/,IS/'S'/,IK/'K'/
01400 1,KLST/'B','E','A','D', 'F','C','G','D'/
01500 1,FOR/'(I4,F',0,'4.2,A','1) '/,F3/'3.0,F'/,F4/'4.0,F'/
01600 EQUIVALENCE (ID,LET(4)),(IF,LET(6)),(IM,LET(13)),(IN,LET(14))
01700 1,(RI,I)
01800
01900 TYPE 1
02000 1 FORMAT(' TYPE FILE NAME -- '$)
02100 2 FORMAT(A5)
02200 ACCEPT 2,NAME
02300 TYPE 3
02400 ACCEPT 2,NM2
02500 3 FORMAT(' TYPE OUTPUT NAME -- '$)
02600 20 FORMAT(I,72A1)
02700 22 FORMAT(' 100 ',72A1)
02800 IF(NM2.EQ.IBLA)NM2='TABL'
02900 CALL IFILE(1,NAME)
03000 CALL OFILE(21,NM2)
03100 ISGN=0
03200 JND=0
03300
03400 240 MODE=-1
03500 READ(1,20,END=102)L,I
03600 TYPE 20,L,I
03700 C READS SOS LINE NUMBERS
03800
03900 IMIN=0
04000 ITOT=0
04100 ICHRD=0
04200 NN=1
04300
04400 NTS=-1
04500 21 N=1
04600 8 J=0
04700 NX=0
04800 NL=-1
04900 31 JM=M
05000 M=I(N)
05100 IF(M.EQ.LSL)GO TO 10
05200 IF(M.EQ.ICOL)GO TO 10
05300 IF(M.EQ.ISEMI)GO TO 13
05400 IF(M.NE.IBLA)GO TO 36
05500 IF(JM.EQ.M)GO TO 35
05600 C NEVER MORE THAN ONE BLANK AT A TIME.
05700 GO TO 7
05800
05900 36 DO 32 K=1,14
06000 32 IF(M.EQ.LET(K))GO TO 11
06100 IF(M.NE.IS.AND.M.NE.IR)GO TO 76
06200 C FINDS 'S' OR 'R'
06300 LETX=0
06400 NX=NX+1
06500 IQ(NX)=M
06600 N=N+1
06700 M=I(N)
06800 GO TO 7
06900 C FOR 'SD' AND 'SU', 'RD', 'RI'
07000
07100 76 IF(M.EQ.'0')GO TO 74
07200 C BASS STRINGS ARE 0, -1, -2, ETC. -- ALSO USE /SD/
07300 IF(M.NE.MIN)GO TO 33
07400
07500 9 IMIN=-1
07600 LETX=-1
07610 J=0
07655 C SO OCT. NUM WILL APPEAR FOR HIGH NOTES AFTER BASS STRINGS
07700 N=N+1
07800 M=I(N)
07900 33 DO 34 K=1,8
08000 34 IF(M.EQ.NUM(K))GO TO 12
08100 LETX=0
08200 IF(M.NE.IK)GO TO 37
08300 ISGN=1
08400 C FOUND A KSIG
08500 39 NX=NX+1
08600 IQ(NX)=M
08700 N=N+1
08800 M=I(N)
08900 IF(M.NE.MIN)GO TO 33
09000 C FOUND MINUS
09100 ISGN=-1
09200 GO TO 39
09300
09400 74 L=7
09410 J=0
09500 LETX=-1
09600 77 NX=NX+1
09700 C FOR OCTAVE NUM
09800 IQ(NX)=LET(L)
09900 NX=NX+1
10000 M=3
10100 IF(L.LT.3)M=2
10200 IQ(NX)=NUM(M)
10300 GO TO 35
10400 75 L=7-K
10500 IMIN=0
10600 GO TO 77
10700
10800 37 IF(M.EQ.IZ)M=IM
10900 C CHANGE Z (MEASURE) TO M
11000 GO TO 7
11100
11200 35 N=N+1
11300 IF(N.LT.72)GO TO 31
11400 IF(NX.GT.72)GO TO 101
11500 WRITE(21,22)(IQ(K),K=1,NX)
11600 TYPE 22,(IQ(K),K=1,NX)
11700 14 IF(MODE)GO TO 140
11800 MODE=MODE+1
11900 IF(MODE.EQ.3)GO TO 240
12000 C FOR RESTART. DON'T PUT BASS STRS FIRST. ONLY 1 LN FOR BMS &SLRS
12100 140 READ(1,20,END=100)L,I
12200 TYPE 20,L,I
12300 IF(NTS)GO TO 21
12400 C NEXT FOR LINES AFTER NOTES.
12500 C NEXT FOR STRING NUMS.
12600 IF(I(1).NE.IBLA)GO TO 70
12700 C TO SKIP ALL RHYTH LINES
12800 IF(MODE.GE.0)GO TO 70
12900 C SO WE WON'T EVER COME BACK HERE
13000 73 L=0
13100 NL=LSL
13200 CC ITOT=ITOT-1
13300 FOR(2)=F3
13400 NA=0
13500 DO 71 K=1,ITOT
13600 C ITOT = TOTAL NUM OF NOTES
13700 A=STR(K)
13800 IF(A)GO TO 71
13810 JJ=K
13820 171 JJ=JJ+1
13830 IF(STR(JJ).GT.0)GO TO 272
13835 IF(JJ.EQ.ITOT)NL=ISEMI
13840 GO TO 171
13900 272 NA=NA+1
14000 L=L+2
14100 RI(L-1)=NA
14200 RI(L)=A*.01
14300 IF(K.EQ.ITOT)NL=ISEMI
14400 IF(NA.GT.9)FOR(2)=F4
14500 CC71 WRITE(21,72)RI(L-1),RI(L),M
14600 TYPE FOR,M100,RI(L-1),RI(L),NL
14700 WRITE(21,FOR)M100,RI(L-1),RI(L),NL
14850 71 CONTINUE
15000 MODE=0
15100 C NOW SET MODE COUNTER TO PREPARE FOR RESTART
15200 GO TO 14
15300 70 WRITE(21,22)(I(K),K=1,72)
15400 GO TO 14
15500 100 IF(NL.NE.ISEMI)GO TO 73
15600 102 STOP
15700 101 FORMAT(' TOO MUCH ON LINE')
15800 TYPE 101
15900 STOP
16000
16100 11 NL=K
16200 C THE NUMB. OF THE LETTER
16300 LETX=-1
16400 GO TO 35
16500 12 IF(ISGN.EQ.0)GO TO 47
16600 C NEXT FOR KSIG SETUP
16700 JFST=5
16800 IF(ISGN)JFST=1
16900 JND=JFST+K-1
17000 ISGN=0
17100 47 IF(IMIN)GO TO 75
17200 C JUMP FOR BASS STRINGS
17300 IF(NL)GO TO 7
17400 NN=K
17500 C THE NUMBER
17600 GO TO 35
17700
17800 C NEXT AFTER IT FOUND SLASH OR SEMICOLON
17900 13 NTS=0
18000 10 IF(LETX.EQ.0)GO TO 110
18100 ITOT=ITOT+1
18200 C SAVE THE STRING NUM.
18300 NA=NN
18400 IF(ICHRD.EQ.ICOL)NA=-1
18500 C FLAG FOR CHORD NOTES (CAN'T SPECIFY STRING IN BEAMS SUBR.)
18600 STR(ITOT)=NA
18700 ICHRD=M
18800 110 IF(NL)GO TO 7
18900 JOCT=0
19000 GO TO(41,42,43,44,45,46),NN
19100 46 NA=0
19200 GO TO 5
19300 45 NA=5
19400 C THESE ARE ADDERS FOR 'LIST'
19500 GO TO 5
19600 44 NA=8
19700 GO TO 5
19800 43 NA=0
19900 GO TO 6
20000 C NOW ON THE UPPER 3 STRINGS
20100 42 NA=5
20200 GO TO 6
20300 41 NA=8
20400 6 JOCT=1
20500 C THE OCTAVE ADDER
20600 5 NX=NX+1
20700 NB=NL+NA
20800 C PUT A NOTE AWAY
20900 18 L=LIST(NB)
21000 IQ(NX)=L
21100 C THE FOUND-NOTE FLAG
21200 C SAVE THE STRING NUM.
21300 58 GO TO(51, 52,51,51, 55,51, 52,51,51, 55,51, 55,51, 52),NB
21400 C FINDS FLAT OR SHARP -- WHAT ABOUT KSIG.
21500 52 K=IF
21600 GO TO 50
21700 55 K=IS
21800 50 IF(JND.EQ.0)GO TO 53
21900 DO 54 KA=JFST,JND
22000 54 IF(L.EQ.KLST(KA))GO TO 56
22100 C LOOK FOR KSIG MATCH UP
22200 GO TO 53
22300 56 IF(K.NE.0)GO TO 57
22400 K=IN
22500 C MAKES A NATURAL
22600 53 NX=NX+1
22700 IQ(NX)=K
22800 57 NA=3
22900 NL=-1
23000 IF(NB.GT.3)NA=4
23100 NA=NA+JOCT
23200 IF(J.EQ.NA)GO TO 7
23300 C AVOIDS REPEATING OCT. NUM
23400 J=NA
23500 NX=NX+1
23600 IQ(NX)=NUM(NA)
23700 7 NX=NX+1
23800 IQ(NX)=M
23900 IF(M.EQ.ISEMI)NTS=0
24000 GO TO 35
24100 51 K=0
24200 GO TO 50